C ********** SC3A.F4 ******* SEE RUN.CMD, SCORE.CMD   -- 
C   AND, IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C	SUBROUTINE SUBR
C	COMMON /P/P(1) /PL/IPL(1) /INS/ RINST(27),BG(60)
C	COMMON INUM,IPAR /KNT/KNT(27),BT,IREST,DF /DUR/DUR(27)
C   INUM=INST#  IPAR=PARAM#  
C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
C   RINST=INST. NAME,  BG=INSTS' BEGIN TIMES.
C   NOTE #S IN SUBROUTINE: (1-108)  C4=49  FS4=55  B4=60  C5=61  ETC.
C   F0=200  F99=299 (LIMIT IS F0-F99!)  'R'(REST)=199

	SUBROUTINE RUNIT
	INTEGER PL,PL4,COPYL
	COMMON /PCIP/ PCH(27,33) /IPT/IPT(27,32) /JPREC/JPREC
C 2ND NUM IN IPT=NUMP+2. (NUMPY)
C PL SHOULD HAVE ABOUT NUMP+17
	COMMON/P/P(30)/PL/PL(47)/NUMP/NUMP,NUMPX,NUMPY /IRX/IR1,IR2
	1 /COPY/COPY(30)  /COPYL/COPYL(30),IT(30)
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20

	COMMON /Q/BNW(200),NWZ/INS/RINST(27),BG(60)/TYP/JOUT,LN,KTYPE
	1  /ROFF/ROFF(27),RDEV(27),P1(27)
	1 /VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
	1 /COFF/RREST(27),RNP(27)
C  JPT MUST BE .LE.27*NUMPY !!
	DIMENSION JPT(837),NCNT(27,32)
C   WITH VX AT 70 AND FRM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON J,L /DUR/DUR(27) /KNT/KNT(27),BT,IREST,DF
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,SPACE
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,FNAME,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
	1 /INTC/NWZZ,IT3,NW,KODE,NPAR,LP,NPA,IBX,IZ,IA
	1  /REALC/T,T1,BY,T6,T2,RD,TDUR,T4,AC
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT
C  JPT MUST BE .LE.27*NUMPY !!
	EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
	1 (VX1,VX(1)),(IPT,JPT)
	1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
	DATA IR1/0/,IR2/0/,RNDOFF/1000.0/,IBLA/' '/,PLAY/'PLAY'/,
	1 ISEMI/';'/


	IF(JPREC.GE.0)GO TO 9350
C NOW FOUND 'PRECEDE' MATERIAL TO TYPE OR WRITE ON DSK.
9351	READ(ID21,END=9350)K,(XT(J),J=1,K)
CCCC	IF(MZ.LT.0)WRITE(JOUT,9352)(XT(J),J=1,K)
	IF(MX.LT.0)WRITE(ID20,9353)(XT(J),J=1,K)
	GO TO 9351
9352     FORMAT(1X20A4)
C11 ******* USE 20A4 IN FORMAT STATEMENT
9353     FORMAT(20A4)
9350	ITOT=1
	SPACE=0
C FOR SPACE BETWEEN NOTES IN PRINTOUT
	NUMPX=NUMP+1
	NUMPY=NUMP+2
	PR=0
	DO 9337 K=1,27
	KNT(K)=0
	RDEV(K)=0
	IPT(K,1)=0
9337	RREST(K)=0
C  ZEROS NAME CHANGE, CUTOFF AND RAND REST STORAGE
2337	T=0
	DO 1107 K=1,NUMP
1107	PL(K)=1
C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
	WRITE(JOUT,902)
C   WRITES A BLANK LINE  (IF 'SOS' WAS HERE)
	NWZZ=0
	RAMP=0
	IT3=0
	K=1
      IX=0  
	BG(NINS+1)=19999.
4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
	V(I)=-19899.
      PP1=0
      T6=10000.   
      DO 2118 K=1,NINS  
	ROFF(K)=0
C********* FEB 17,71
	M=NP(K)
      IT(K)=0 
	IPT(K,NUMPX)=0
	NCNT(K,NUMPX)=1
	DO 2118 L=1,M
	NCNT(K,L)=1
2118	IPT(K,L)=0
	DO 5013 K=1,IXIN
5013	X=RAN(X)
C  NOW USES EXTENSION .DAT WHEN WRITING ON DSK (DEV. 1 ONLY!)
      NW=1    
	NWX=0
      TDUR=0
	A=0
      T2=1. 
      T4=1. 
      T5=0  
	J=1
	IF(MX.NE.5)GO TO 1002
CKL	IF(MX.NE.5)GO TO 40021
	K=4
10023	N=AMOD(V(K),100.0)/-11.
C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
	IF(N.EQ.2)GO TO 77
	IF(N.EQ.3)GO TO 77
	IF(N.NE.4)GO TO 10021
C TYPES OUT LIST OF ITEMS IN CODE NUMS -2n, -3n, -4n.
77	IF(V(K-2).LT.10000.)GO TO 10021
C FINDS A PARAM. NUM.
	J=V(K+1)
	KA=K+ABS(V(K-1))
C FOR UPDATE OF POINTER.
	IF(J.EQ.1)GO TO 10024
177	N=V(K-2)
	L=N/10000
	M=N-L*10000
	IF(V(KA-2).EQ.-10000.)J=J-1
C DON'T INCLUDE 'FINE' AS AN ITEM.
	WRITE(JTYPE,10022)RINST(L),M,J
10024	K=KA
10021	K=K+1
	IF(K.LT.I)GO TO 10023
10022	FORMAT(1XA4,' P',I2,'  HAS ',I3,' ITEMS.')
1002	IF(IDALL.LT.0)GO TO 600
	X=DUR(IDALL)
	DO 2002 K=1,NINS
2002	IF(DUR(K).LT.0)DUR(K)=X

C ***** SORTER *************************  
C  *******  OUTPUT LOOP FROM HERE ON  ********
600      IL=0     
C********** BELOW IS FOR 'SECTIONS'
	KODE=0
	NWX=NWX+1
      Y=BNW(NW)   
723      IL=IL+1  
3723      Z=V(IL)     
      IF(Z.EQ.-19899.)GO TO 732
      IF(Z.NE.-9900.-Y)GO TO 723     
C********** BELOW IS FOR 'SECTIONS'
2723      IL=IL+1   
729	K=IL+2
	MOT=V(IL+1)
	RD=V(K)
	IF(RD.EQ.-67.)GO TO 3726
	RB=V(IL)
4150	LK=RB/10000.+.2
	IF(LK.GE.98)GO TO 7700
	LP=RB-LK*10000
C   LK=INST #   LP=PARAM #
	LN=IPT(LK,LP)
	IPT(LK,LP)=IL+2
	IF(RD.EQ.-66.)GO TO 726
	IF(IFIX(RD/-10.).EQ.5)GO TO 1726
C -59=MOVX, -55=MOV.

2727	ML=IPT(LK,LP)
	IF(MOT.GT.0)GO TO 3727
C  USE NEG WDCNT FOR 'ALL'
	DO 4727 KL=LK+1,NINS
	IF(NP(KL).GE.LP)GO TO 277
	IF(LP.LT.NUMPX)NP(KL)=LP
277	IPT(KL,LP)=-(LK+(LP-1)*KZY)
	NCNT(KL,LP)=10000
4727	IF(DUR(KL).LT.0)DUR(KL)=10000.
C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
	GO TO 727
C 'MOVE' WITH 'ALL' KEEPS ORIGINAL BG TIME DATA REGARDLESS OF LATER BG TIMES.
3727	IF(LN.LE.0)GO TO 727
    	IF(V(IL).NE.V(LN-1))GO TO 727
	DO 1727 L=1,NINS
	DO 1727 KL=1,NP(L)
	IF(LN.NE.IPT(L,KL))GO TO 1727
	NCNT(L,KL)=10000
	IPT(L,KL)=ML
C RESETS POINTERS FOR DUPL AND REP INSTS.
1727	CONTINUE

727	NCNT(LK,LP)=10000
2150	IF(MOT.LT.0)MOT=-MOT
	IL=IL+MOT+1
3150	IF(V(IL).LT.0)GO TO 3723
	GO TO 729
726	RB=V(IL+3)
	K=RB/10000.
	L=RB-K*10000
	IPT(LK,LP)=-(K+(L-1)*KZY)
	GO TO 2727
3726	LK=V(IL)
	M=V(K+1)
	KL=NP(M)
	DO 4726 L=1,KL
	IPT(LK,L)=IPT(M,L)
	IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
4726	CONTINUE
C NUMPX =31 (NUMP+1) NEXT DUPLS. RAN. RESTS.
	IPT(LK,NUMPX)=IPT(M,NUMPX)
	K=0
	GO TO 2150

C  BELOW FOR 'TEMPO' SETUP
7700	T2=V(IL+4)
	T1=V(IL+3)
	TBG=Y
	TDUR=V(IL+2)
	CALL SQYY(AC,T1,T2,TDUR)
8700	IF(TDUR.EQ.0)TDUR=10000.
	T5=1.
	T6=TBG+TDUR
	IT3=1.
	IF(LK.EQ.98)IT3=IL+2
	T4=1.
	GO TO 2150
C*************** ANY WDCNTS DOWN FROM HERE. *********
C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
1726	IF(V(IL-1).GT.-19000.)GO TO 2727
	RA=BT
	K=IL-1
2726	RZ=V(K)
	V(K)=-9900.-RA
	ISUB=-1
	L=K+5
	K=K+V(K+2)+2
	IF(V(K).GT.-19000.)GO TO 2727
	IF(V(K+1).NE.V(IL))GO TO 2727
	
	IF(V(K).NE.RZ-V(L-1))GO TO 2727
	RA=RA+V(L-1)
	CALL BGSORT(RA)
	GO TO 2726
C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
732	DO 2606 K=NW,NWZ
2606	BNW(K)=BNW(K+1)
	NWZ=NWZ-1
	IF(NWZ.EQ.0)GO TO 2111
	IF(NWZZ.EQ.1)GO TO 5111
	NWZZ=1
	IF(NWZ.EQ.1)GO TO 1111
	DO 3111 K=1,NWZ
	IF(BNW(K).LT.1000.)GO TO 3111
	X=BNW(NWZZ)
	BNW(NWZZ)=BNW(K)
	BNW(K)=X
	NWZZ=NWZZ+1
3111	CONTINUE
5111	IF(NWZZ.EQ.NWZ)GO TO 1111
	L=NWZZ+1
	X=BNW(NWZZ)
	DO 4111 K=L,NWZ
	IF(BNW(K).GT.X)GO TO 4111
	RA=BNW(K)
	BNW(K)=X
	X=RA
4111	CONTINUE
	BNW(NWZZ)=X
	GO TO 1111
111      FORMAT(1XA4,'.DAT',12X,'EDIT FILE NAME=',A4,8X,
	1'STORAGE=',I5,'/',I5,/' TEMPO FACTOR=',F6.2/)
1023	FORMAT(/'  < ',A4,'.DAT  --  RANDOM NUMBER=',I6/1X2A4)
902	FORMAT(1XA4/)
2111	NWZ=-1
C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
1111	IF(MZ.EQ.0)GO TO 2601
      IF(NWX.EQ.1)WRITE(JOUT,111)FNAME,FLNM,I,LIMIT,TF
	K=NWX-1
        IF(NWX.LE.1)GO TO 377
	IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
377	IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,IBX,RINST(J) 

2601  DO 602 K=1,NINS   
48	RIN=RINST(K)
  	IF(NCNT(K,NUMPX).EQ.10000)GO TO 477
	IF(NWX.GT.1)GO TO 602
477	NCNT(K,NUMPX)=1
	IJ=IPT(K,NUMPX)
	X=0
	IF(IJ.NE.0)X=ALL(JPT,IPT(K,NUMPX))
C CHECK FOR "ALL" WITH RAND. DEV.  
	WRITE(JOUT,5396)K,RIN,X
	X=DUR(K)
      IF(X.GT.10000.)GO TO 83 
      WRITE(JOUT,8396),X     
	GO TO 602
5396      FORMAT(I3,') 'A4,'  RANDOM TF =',F4.2,7X,'DURATION =',$) 
7396      FORMAT('+',F5.0,' NOTES')    
8396      FORMAT('+',F7.2,'"')   
83      X=X-10000.
      WRITE(JOUT,7396),X    
602	CONTINUE
	IF(MZ.EQ.0)GO TO 1601
715	IF(IT3.NE.1.)GO TO 1602
	RA=T1*60.
	RB=T2*60.
      WRITE(JOUT,6154),RA,RB,TDUR  
      IT3=0  
1602	IF(NWX.EQ.1)GO TO 315
      IF(IT(J).EQ.-3)GO TO 1108
	IT(J)=IT(J)/10
1108	NRN=-1
C NRN IS FLAG FOR NEXT SUBROUTINE
	GO TO 500
6154      FORMAT(' TMP=',F7.3,' TO',F8.3,
	1' DURING',F6.2,' SECS. BASIC TIME.'/)
5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',I4,1XA4,' >>'/)
3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
315	IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
1601  IF(NWX.GT.1) GO TO 1108
	IF(TF.GT.10.)TF=TF/60.
	TF=RNDOFF/TF
C RNDOFF IS ROUND OFF NUMBER. (100 OR 1000)
CROFF	 100 HERE FOR NEW DAC!?#@&βX 1/76  TF=1000./TF
	DO 6015 K=3,NUMP
	COPYL(K)=-9900
6015	COPY(K)=-9900.
C  INITS PARAM REPRESSION FEATURE.
9926      DO 5015 K=1,NINS    
	IQ(K)=BG(K)*1000.
      BG(K)=0
	RNP(K)=0
      P1(K)=0     
	IF(DUR(K).LE.10000.)DUR(K)=DUR(K)-.0001
C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
5015      KNT(K)=0
   	IF(MZ.LT.0)WRITE(JOUT,1023),FNAME,IXIN,PLAY,ISEMI
	IF(MX.LT.0)WRITE(ID20,1023)FNAME,IXIN,PLAY,ISEMI
      BW=0 
CCC	GO TO 500
	NRN=0
500	CALL RUN2(NRN)
	GO TO 600
	END